{-# OPTIONS -fno-warn-missing-signatures #-}
{-# LANGUAGE CPP, ScopedTypeVariables #-}

module Main where

import Helper
--import Types
--import Survey
--import Survey.TWOMASS
--import Survey.DENIS
--import Survey.WBVR
--import Model   ( ModelParameter(..) )
import Model
import ObsData ({-- AnyObsData(..), --}genModel)


--import Model.Photometry ( mag )

import Fitting

import Loader ( getContext )

--import qualified Model.Pickles                as Pickles
import qualified Model.Castelli               as Castelli
import qualified Model.InterstellarExtinction as IE

import Text.Printf (printf)

import Control.Monad (forM_, forM)
import Control.Applicative  ( (<$>) )
import Control.Monad.Reader ( runReaderT, liftIO  )

import Data.HList

import Numeric.LevMar

main :: IO ()
main = do

 (aos,ps,c) <- getContext "main.cfg"

 runReaderT (process aos ps) c

process aos _ = do

--  let aos = [AnyObsData wbvr] -- [AnyObsData ijk, AnyObsData jhk]

--  sed  <- Pickles.model classV
  sed  <- Castelli.model
  ie   <-       IE.model

  ds   <- Castelli.domains

  forM_ aos $ \(hd, ao) -> do

       (d,m) <- genModel ao

#if MEMO
       c  <- liftIO $ mkCache 100

       let f = memo c $ m <$> sed .* ie
#else

       let f = m <$> sed .* ie
#endif

--{--
       let outfile = printf "out_%s.txt" $ (/=' ') `filter` hd

       liftIO $ do
          writeFile  outfile $ printf "# %s\n" hd
          appendFile outfile $ printf "# %8s %10s %10s %10s %10s %10s %10s %10s\n" "iTeff" "iLogg" "iEbv" "rTeff" "rLogg" "rEbv" "rNorm2E" "irNorm2E"
--}

       forM_ ds $ \(bc,ps) -> do

         let b = ( (fst bc) `hAppend` (Ebv  0 ::: Null)
                 , (snd bc) `hAppend` (Ebv 10 ::: Null)
                 )

         forM ps $ \pc -> do

               let p = pc `hAppend` (Ebv 0 ::: Null)

               liftIO $ do
                  putStrLn $ "\n\n" ++ hd
                  putStrLn $ "Initital guess : " ++ prettyShow p
                  putStrLn $ "Observation    : " ++ prettyShow d
                  putStrLn $ "lowerBounds    : " ++ prettyShow (fst b)
                  putStrLn $ "upperBounds    : " ++ prettyShow (snd b)

               r <- (f) `fitTo` (d,p,b)

               liftIO $ do
                  prettyPrint f r

--{--
                  case r of
                    Right (p',info,_) -> do

                      let (Teff teff  ::: Logg logg  ::: Ebv ebv  ::: Null) = p
                          (Teff teff' ::: Logg logg' ::: Ebv ebv' ::: Null) = p'
                  
                      appendFile outfile $ printf "%10.4f %10.4f %10.4f %10.4f %10.4f %10.4f %10.4g %10.4g\n" teff logg ebv teff' logg' ebv' (infNorm2E info) (infNorm2initE info)

                    _ -> return ()
--}

               return (p,r)

{--	

--- Для тестирования

ijk = (I DENIS   1, J DENIS   2, K DENIS   3)
jhk = (J TWOMASS 1, H TWOMASS 2, K TWOMASS 3)

ijk :: Factory (SED -> IJK)
ijk = mkFunc

jhk :: Factory (SED -> JHK)
jhk = mkFunc

kkh :: Factory (SED -> (K TWOMASS, K DENIS, H TWOMASS))
kkh = mkFunc

--}

--prettyPrint :: Either LevMarError (Params r, Info r, Matrix r) -> IO ()
--prettyPrint :: (PrettyShow a, PrettyShow b) => ( a -> b) -> Either LevMarError (a, Info r, m) -> IO ()
prettyPrint _ (Left err) = putStrLn $ "\tError: " ++ msg where
  msg = case err of
          LevMarError                    -> "Generic error (not one of the others)"
          LapackError                    -> "A call to a lapack subroutine failed in the underlying C levmar library."
          FailedBoxCheck                 -> "At least one lower bound exceeds the upper one."
          MemoryAllocationFailure        -> "A call to malloc failed in the underlying C levmar library."
          ConstraintMatrixRowsGtCols     -> "The matrix of constraints cannot have more rows than columns."
          ConstraintMatrixNotFullRowRank -> "Constraints matrix is not of full row rank."
          TooFewMeasurements             -> "Cannot solve a problem with fewer measurements than unknowns. In case linear constraints are provided, this error is also returned when the number of measurements is smaller than the number of unknowns minus the number of equality constraints."

prettyPrint f (Right (ps,info,matrix)) = do
  putStrLn $ "Result         : " ++ (prettyShow $ f ps)

  putStrLn $ "------"
  putStrLn $ "The solution of nonlinear least-squares problem:"
  putStrLn $ prettyShow ps
  putStrLn $ "------"

  printf "Information regarding the minimization:\n"
  printf "\tinfNorm2initE   = %g\n" (infNorm2initE info)
  printf "\tinfNorm2E       = %g\n" (infNorm2E info)
  printf "\tinfNumIter      = %d\n" (infNumIter info)
  printf "\tinfNumFuncEvals = %d\n" (infNumFuncEvals info)
  printf "\tinfStopReason   = %s\n" (show $ infStopReason info)    